home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 004 / weightfm.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-06-10  |  3.9 KB  |  90 lines
  1. 5  CLS:KEY OFF:SCREEN 0,0,0:WIDTH 80:CLEAR:FOR I=1 TO 10:KEY I,"":NEXT:KEY 2,"GOTO 60"+CHR$(13):KEY 10,"RUN"+CHR$(34)+"BLUEMENU"+CHR$(34)+CHR$(13):LIST 10-57
  2. 10  '***************************************************************************
  3. 16  'KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE
  4. 18  'OPEN                  DAILY WEIGHT RECORD "MOTIVATION" FORM                  OPEN
  5. 20  'OPEN                                                                         OPEN
  6. 22  'OPEN    The form generated by this program can be used to maintain daily or  OPEN
  7. 24  'OPEN other periodic health records.  The form is designed primarily for a    OPEN
  8. 26  'OPEN weight record; however, the word "WEIGHT" can be replaced easily by any OPEN
  9. 28  'OPEN other word or dimension for which a daily or periodic record might be   OPEN
  10. 30  'OPEN appropriate.  The form can be modified easily to increase or decrease   OPEN
  11. 31  'OPEN the number of lines by making an appropriate change in the number of    OPEN
  12. 32  'OPEN loops printed.  The loop size entry 27 and is currently set at 24 to    OPEN
  13. 33  'OPEN make the form the right length with its present format and content.     OPEN
  14. 34  'OPEN To run the form as designed, simply set print head at the first line    OPEN
  15. 35  'OPEN below the perforation and ascertain the printer is ON LINE. Press <F2>. OPEN
  16. 36  'OPEN                   (c) G I N A C O    1983              Ver 5.1/160/320  OPEN
  17. 38  'SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD
  18. 55  '        *****  < F2 > to RUN  *******  < F10 > For BLUEMENU  *****
  19. 57  ' ====== To avoid DOCUMENTATION BOX each time, REM or DELETE  line 5 ======
  20. 60  CLS:KEY OFF:SCREEN 0,0,0:WIDTH 80:CLEAR:FOR I=1 TO 10:KEY I,"":NEXT
  21. 80  REM ===== INITIALIZE PRINTER CODES =====
  22. 90  GOSUB 5000
  23. 100  ON ERROR GOTO 6000
  24. 110  REM ===== PUT IN FORM HEADING =====
  25. 120  LPRINT CLEANUP$;
  26. 130  WIDTH "LPT1:",96
  27. 140  LPRINT DARK$;
  28. 150  LPRINT STRING$(4,10);
  29. 160  LPRINT EXPAND$;STRING$(39,42)
  30. 170  LPRINT
  31. 180  LPRINT EXPAND$; TAB( 2);"D A I L Y    W E I G H T    C H A R T"
  32. 190  LPRINT
  33. 200  LPRINT EXPAND$;STRING$(39,42)
  34. 210  LPRINT
  35. 220  LPRINT TAB( 3);EXPAND.SMALL$"START WEIGHT:"START.ULINE$"_         _";END.ULINE$"_           _";"DESIRED WEIGHT:"START.ULINE$"_         _";END.ULINE$
  36. 230  LPRINT CLEANUP$;
  37. 240  LPRINT DARK$
  38. 250  LPRINT EXPAND$;STRING$(39,"=")
  39. 260  LPRINT ONEWAY$;
  40. 270  FOR I = 1 TO 22
  41. 280  LPRINT EXPAND.SMALL$;"DATE: "START.ULINE$"_      _"END.ULINE$;"   ";"WEIGHT: "START.ULINE$"_     _"END.ULINE$;" || ";"DATE: "START.ULINE$"_     _"END.ULINE$;"   ";"WEIGHT: "START.ULINE$"_     _"END.ULINE$
  42. 290  LPRINT EXPAND$;TAB(34);"||"
  43. 300  NEXT
  44. 310  LPRINT
  45. 320  LPRINT EXPAND$;TAB(15)"MONTH: "START.ULINE$"_        _"END.ULINE$;"        ";"YEAR: "START.ULINE$"_        _"END.ULINE$
  46. 330  LOCATE 10,30:PRINT"THE FORM IS PRINTING"
  47. 340  LPRINT CHR$(12):END
  48. 5000  '========== PRINTER CONTROL SUBROUTINE ==========
  49. 5030  SMALL$ = CHR$(15)
  50. 5060   UNSMALL$ = CHR$(18)
  51. 5090    EXPAND.SMALL$ = CHR$(14) + CHR$(15)
  52. 5120     CANX.EXP.COMP$ = CHR$(18) + CHR$(20)
  53. 5150      EXPAND$ = CHR$(14)
  54. 5180       EXPAND.END$ = CHR$(20)
  55. 5210        DARK$ = CHR$(27) + CHR$(69)
  56. 5240         ITALIC$ = CHR$(27) + CHR$(52)
  57. 5270          ITALIC.EXP.CON$ = CHR$(14) + CHR$(15) + CHR$(27) + CHR$(52)
  58. 5300  ITALIC.EXP$ = CHR$(27) + CHR$(52) + CHR$(14)
  59. 5330   END.ITALIC$ = CHR$(27) + CHR$(53)
  60. 5360    START.ULINE$ = CHR$(27) + CHR$(45) + CHR$(1)
  61. 5390     END.ULINE$ = CHR$(27) + CHR$(45) + CHR$(0)
  62. 5420      PERM.EXPAN$ = CHR$(27) + CHR$(87) + CHR$(1)
  63. 5450       END.PERMEXP$ = CHR$(27) + CHR$(87) + CHR$(0)
  64. 5480  START.DSTRIKE$ = CHR$(27) + CHR$(71)
  65. 5510   END.DSTRIKE$ = CHR$(27) + CHR$(72)
  66. 5540    TINYLINE$ = CHR$(27) + CHR$(83) + CHR$(0)
  67. 5570     END.TINY$ = CHR$(27) + CHR$(84)
  68. 5600      ESC$ = CHR$(27)
  69. 5630       ONEWAY$ = CHR$(27) + CHR$(85) + CHR$(1)
  70. 5660        END.ONEWAY$ = CHR$(27) +CHR$(85) + CHR$(0)
  71. 5680         CLEANUP$ = CHR$(27) + CHR$(64)
  72. 5690          RETURN
  73. 6000  REM ********* PRINTER ERROR ROUTINE ***************
  74. 6030  IF ERR = 24 THEN 6120 ELSE 6060
  75. 6060  IF ERR = 25 THEN 6120 ELSE 6090
  76. 6090  ON ERROR GOTO 0
  77. 6120  KEY OFF
  78. 6150   BEEP
  79. 6180    BEEP
  80. 6210     LOCATE 25,1
  81. 6240      PRINT SPC( 79)
  82. 6270       LOCATE 25,20
  83. 6300        PRINT "CHECK PRINTER - PRESS ANY KEY TO CONTINUE"
  84. 6330  IF INKEY$ = "" THEN 6330
  85. 6360  KEY OFF
  86. 6390   RESUME
  87. 6420    END
  88. 65000  REM ==========  SAVE ROUTINE  ==========
  89. 65100  SAVE "B:WEIGHTFM.BAS"
  90.